Abordarei neste tópico uma forma de explorar informações contidas em um determinado canal do Youtube. Como exemplo, estarei demonstrando a obtenção e análise dos dados proveniente do canal “Nerdologia”, dos autores Atila Iamarino e Filipe Figueiredo. Os dados manipulados servem como base para a apresentação gráfica em um dashboard dinâmico, desenvolvido em Shiny (linguagem R). Por hora, proponho a análise quantitativa de métricas como visualizações, likes, dislikes e comentários. Bem como a análise textual das legendas geradas automaticamente pelo sistema do Youtube (quando habilitado pelo(s) autor(es) do canal).
Infelizmente o acesso ao texto completo dos comentários é limitado pela API do Youtube, portanto eles não foram analisados (motivos financeiros). A motivação para este estudo é meramente e unicamente por uma questão de curiosidade e pelo exercício da criatividade. Bem como uma forma divertida de se aperfeiçoar cada vez mais nas ferramentas da linguagem R (programação, métodos de exploração de dados, desenvolvimento de dashboards, etc.).Primeiramente foi realizada a extração dos dados brutos. Para as métricas quantitativas, utilizei a API do Youtube (necessita de cadastro prévio) via pacote tuber do R. As legendas automáticas foram baixadas usando o pacote RCurl juntamente com a ferramenta online diycaptions ( http://diycaptions.com).
Os dados textuais foram processados pelas funções do pacote tm e visualizados usando a ferramenta wordcloud. No caso das métricas quantitativas do canal, os dados foram visualizados pela ferramenta plotly. A visualização foi realizada dentro de um dashboard desenvolvido em shiny.
Carregando as bibliotecas
library(rvest)
library(ggplot2)
library(dplyr)
library(tidyr)
library(lubridate)
library(plotly)
library(tuber)
library(stringr)
library(tm)
library(wordcloud)
library(RCurl)
library(VennDiagram)
library(kableExtra)
Primeiramente precisamos fazer a autenticação da nossa conta para poder acessar os dados do Youtube. É preciso realizar um cadastro prévio no site e fazer a requisição de chave de acesso (https://developers.google.com/youtube/v3/).
client_id <- 'xxxxxxxx'
key <- 'xxxxxxxx'
yt_oauth(client_id, key)
Agora podemos extrair os dados dos canal alvo, usando o ID dele. Caso não saiba onde encontrar esta informação, é aquela série de caracteres na URL (conforme destacado na figura).
all_vid_nerdologia <- get_all_channel_video_stats(channel_id= 'UClu474HMt895mVxZdlIHXEA', mine= FALSE)
Precisamos formatar ele adequadamente, formatando os tipos de variáveis bem como fazendo uma limpeza na variável dos títulos.
# Dates
date_split_list <- strsplit(x= as.character(all_vid_nerdologia$publication_date), split= 'T')
date_split_list <- lapply(date_split_list, function(x){x[1]}) %>% unlist()
all_vid_nerdologia['publication_date'] <- date_split_list
all_vid_nerdologia$publication_date <- as.Date(all_vid_nerdologia$publication_date)
# Variable class
all_vid_nerdologia$viewCount <- as.numeric(all_vid_nerdologia$viewCount)
all_vid_nerdologia$likeCount <- as.numeric(all_vid_nerdologia$likeCount)
all_vid_nerdologia$dislikeCount <- as.numeric(all_vid_nerdologia$dislikeCount)
all_vid_nerdologia$favoriteCount <- as.numeric(all_vid_nerdologia$favoriteCount)
all_vid_nerdologia$commentCount <- as.numeric(all_vid_nerdologia$commentCount)
# Cleanning data title
all_vid_nerdologia$title <- gsub('\\s\\|\\s.*$', '', all_vid_nerdologia$title)
all_vid_nerdologia %>%
arrange(desc(likeCount)) %>%
head(10) %>%
select(title, likeCount, dislikeCount, commentCount) %>%
kable("html") %>%
kable_styling("striped", full_width= F) %>%
column_spec(1:4, bold= T) %>%
row_spec(1:10, bold= T, color= "white", background= "#3399ff")
| title | likeCount | dislikeCount | commentCount |
|---|---|---|---|
| Suicídio | 114725 | 695 | 5853 |
| Buraco Negro | 113815 | 422 | 4076 |
| Tempo | 104740 | 303 | 3456 |
| CAOS E EFEITO BORBOLETA | 101124 | 423 | 2719 |
| AS MARCAS TE MANIPULAM | 101039 | 305 | 2441 |
| QUAL O SOCO MAIS FORTE? | 101037 | 595 | 6967 |
| SER INVISÍVEL É POSSÍVEL? | 100276 | 221 | 2531 |
| LEVANTE ZUMBI | 99738 | 294 | 3454 |
| O que somos nós? | 98443 | 308 | 4006 |
| Mistérios do Fundo do Mar | 97193 | 577 | 2506 |
all_vid_nerdologia %>%
arrange(desc(dislikeCount)) %>%
head(10) %>%
select(title, dislikeCount, likeCount, commentCount) %>%
kable("html") %>%
kable_styling("striped", full_width= F) %>%
column_spec(1:4, bold= T) %>%
row_spec(1:10, bold= T, color= "white", background= "#ff3333")
| title | dislikeCount | likeCount | commentCount |
|---|---|---|---|
| Sexismo | 13984 | 93561 | 15642 |
| Quem tem mais poder? | 4093 | 91474 | 14424 |
| Existe cura gay? | 2787 | 83583 | 6110 |
| Aquecimento Global | 1854 | 49424 | 3921 |
| Como funciona a Astrologia | 1793 | 74924 | 5447 |
| Maioridade Penal | 1721 | 68294 | 3179 |
| Por que o Merthiolate não arde mais? | 1657 | 59323 | 2362 |
| Motor perpétuo? Carro a água? | 1629 | 52140 | 3355 |
| Coxinhas vs. Petralhas | 1312 | 59094 | 3632 |
| Batman vs Superman | 1175 | 66649 | 2337 |
all_vid_nerdologia %>%
arrange(desc(commentCount)) %>%
head(10) %>%
select(title, commentCount, dislikeCount, likeCount) %>%
kable("html") %>%
kable_styling("striped", full_width= F) %>%
column_spec(1:4, bold= T) %>%
row_spec(1:10, bold= T, color= "white", background= "#4d9900")
| title | commentCount | dislikeCount | likeCount |
|---|---|---|---|
| Sexismo | 15642 | 13984 | 93561 |
| Quem tem mais poder? | 14424 | 4093 | 91474 |
| QUAL O SOCO MAIS FORTE? | 6967 | 595 | 101037 |
| É só uma teoria | 6120 | 690 | 92609 |
| Existe cura gay? | 6110 | 2787 | 83583 |
| Suicídio | 5853 | 695 | 114725 |
| Como funciona a Astrologia | 5447 | 1793 | 74924 |
| Fomos à Lua? | 5132 | 1120 | 64036 |
| COMO MATAR O WOLVERINE | 4979 | 488 | 89501 |
| POSSESSÃO, ABDUÇÃO OU PARALISIA DO SONO? | 4901 | 355 | 90767 |
Agora, deixarei salvo o objeto da tabela processada, para carregar dentro do meu dashboard.
save(file= 'all_vid_nerdologia.RObj', all_vid_nerdologia)
A função do pacote tuber que realiza a extração das legendas não está funcionando mais, por isso eu optei por um modo semi-rudimentar para fazer isso (porque demora um pouco :/). Tive que colocar um delay de 30 segundos em cada requisição pois se formos muito rápido acabamos tendo a conexão interrompinda.
url_request <- paste0('http://diycaptions.com/php/get-automatic-captions-as-txt.php?id=', all_vid_nerdologia$id, '&language=asr')
html_page <- list()
for(i in 1:length(url_request) ){
html_page[i] <- getURL(url_request[i])
Sys.sleep(30)
}
save(file= 'html_page.RObj', html_page)
Agora farei o pré-tratamento dos dados textuais e a limpeza propriamente dita
# Removing tags blocks
html_page_text <- lapply(html_page, function(x){
split_1 <- strsplit(x[[1]], '<br><br>')[[1]][2]
strsplit(split_1[[1]], '\t\t</div>')[[1]][1]
})
# Saving object for individual process
# save(file = 'html_page_text.RData', html_page_text)
# Generating corpus text for all avaiable data
text_df_total <- data.frame(doc_id= all_vid_nerdologia$id, text= unlist(html_page_text), stringsAsFactors= FALSE , drop=FALSE)
text_corpus_df <- Corpus(DataframeSource(text_df_total))
text_corpus_df_filtered <- text_corpus_df %>%
tm_map(stripWhitespace) %>%
tm_map(removePunctuation) %>%
tm_map(removeNumbers) %>%
tm_map(removeWords, c(stopwords("portuguese"))) %>%
tm_map(removeNumbers) %>%
tm_map(stripWhitespace) %>%
tm_map(content_transformer(tolower))
# Creanting a term matrix
corpus_tf <- TermDocumentMatrix(text_corpus_df_filtered)
corpus_m <- as.matrix(corpus_tf)
corpus_m_sorted <- sort(rowSums(as.matrix(corpus_m)), decreasing= TRUE)
df_total <- data.frame(word= names(corpus_m_sorted), freq= as.numeric(corpus_m_sorted))
df_total$word <- as.character(df_total$word)
df_total <- df_total[which(nchar(df_total$word) > 4), ]
O gráfico de frequência total das palavras também deverá aparecer. Porém, lá na ferramenta irei adicionar mecanismos de controle de filtro.
wordcloud(df_total$word, df_total$freq, min.freq= 10, max.words= 150, random.order= FALSE, rot.per= 0.35, colors=brewer.pal(8, "Dark2"))
Farei também uma word cloud para os títulos dos vídeos postados
text_df_total <- data.frame(doc_id= all_vid_nerdologia$title, text= all_vid_nerdologia$title, stringsAsFactors= FALSE , drop=FALSE)
text_corpus_df <- Corpus(DataframeSource(text_df_total))
text_corpus_df_filtered <- text_corpus_df %>%
tm_map(stripWhitespace) %>%
tm_map(removePunctuation) %>%
tm_map(removeNumbers) %>%
tm_map(removeWords, c(stopwords("portuguese"))) %>%
tm_map(removeNumbers) %>%
tm_map(stripWhitespace) %>%
tm_map(content_transformer(tolower))
# Creanting a term matrix
corpus_tf <- TermDocumentMatrix(text_corpus_df_filtered)
corpus_m <- as.matrix(corpus_tf)
corpus_m_sorted <- sort(rowSums(as.matrix(corpus_m)), decreasing= TRUE)
df_total <- data.frame(word= names(corpus_m_sorted), freq= as.numeric(corpus_m_sorted))
df_total$word <- as.character(df_total$word)
df_total_titulo <- df_total[which(nchar(df_total$word) > 2), ]
wordcloud(df_total_titulo$word, df_total_titulo$freq, min.freq= 2, max.words= 100, random.order= FALSE, rot.per= 0.35, colors=brewer.pal(8, "Dark2"))
O gráfico do dashboard deve ser similar a este, porém, responsivo com mais informações e opções de filtro.
all_vid_nerdologia %>%
mutate(proportion_like= likeCount / viewCount,
proportion_dislike= dislikeCount / viewCount) %>%
arrange(publication_date) %>%
plot_ly() %>%
add_trace(x= ~publication_date, y= ~viewCount,
name= 'View count', type= 'scatter',
mode="markers+lines", text= ~paste('Video: ', title),
line= list(color= '#440154FF ', width= 4)) %>%
add_trace(x= ~publication_date, y= ~likeCount,
name= 'Like count', type= 'scatter',
mode="markers+lines", text= ~paste('Video: ', title),
line= list(color= '#39568CFF', width= 4)) %>%
add_trace(x= ~publication_date, y= ~dislikeCount,
name= 'Dislike count', type= 'scatter',
mode= "markers+lines", text= ~paste('Video: ', title),
line= list(color = '#29AF7FFF', width= 4)) %>%
add_trace(x= ~publication_date, y= ~commentCount,
name= 'Comment count', type= 'scatter',
mode= "markers+lines", text= ~paste('Video: ', title),
line= list(color= '#FDE725FF', width= 4)) %>%
layout(xaxis= list(title= "Video publication date"),
yaxis= list (title= "Metric's count"),
font= list(size= 16),
hovermode= 'compare')